
;;; Chapter 8 from Common List - Gentle Introduction.
;;8.5
(defun add-up (lst)
  (if (null lst)
      0
      (+ (car lst) (add-up (cdr lst)))))

;;8.6
(defun alloddp (lst)
  (labels ((alloddp-t (l pr)
	     (cond ((and (null l) pr) t)
		    ((oddp (car l)) (alloddp-t (cdr l) t))
		    (t nil))))
    (alloddp-t lst nil)))

(defun alloddp2 (lst)
  (cond ((null (cdr lst)) (oddp (car lst)))
	((oddp (car lst)) (alloddp2 (cdr lst)))
	(t nil)))

;;8.7
(defun member-rec (obj lst)
  (if (null lst)
      nil
      (if (eql (car lst) obj)
	  lst
	  (member-rec obj (cdr lst)))))

(defun member-rec-2 (obj lst &key key)
  (cond ((null lst) nil)
	((eql (funcall key (car lst)) obj) lst)
	(t (member-rec-2 obj (cdr lst) :key key))))


;;8.8
(defun rec-assoc (key alist)
  (cond ((null alist) nil)
	((eql key (caar alist)) (car alist))
	(t (rec-assoc key (cdr alist)))))
;;8.9
(defun rec-nth (i lst)
  (cond ((null lst) nil)
	((= i 0) (car lst))
	(t (rec-nth (1- i) (cdr lst)))))


;;8.10
(defun rec-plus (a b)
  (labels ((add1 (x)
	     (1+ x))
	   (sub1 (y)
	     (1- y)))
    (cond ((zerop b) a)
	  (t (rec-plus (add1 a) (sub1 b))))))

;;8.11
(defun fib (n)
  (cond ((or (= n 0) (= n 1)) 1)
	(t (+ (fib (- n 1))
	      (fib (- n 2))))))

;;8.12 
;'( 1 3 7) ; works correctly
;'( 1 1 1) ; runs infinitely

;;8.13
; Negetive number.

;;8.14
(defun short-rec (n)
  (short-rec n))

;;8.15
; Car would be 'x
; cdr would the list itself. 
; count-slices would run infinitely if such a list is provided. 

;;8.16 
;Program fails when an empty list is passed as input. 


;;8.17
(defun find-first-odd (x)
  (cond ((null x) nil)
	((oddp (first x)) (first x))
	(t (find-first-odd (cdr x)))))

;;8.18
(defun last-element (x)
  (cond ((atom (cdr x)) (car x))
	(t (last-element (cdr x)))))

;;8.19
; It will work for list that have an odd element.
; It will fail for empty list or for the one that doesn't have any odd element. 


;;8.20
; Augmenting Recursion. 
; Function -> Fact
; End-test -> (zerop n)
; End-value -> 1
; Aug fun -> *
; Aug val -> n
; Reduced n -> (- n 1)


;;8.21 - Add-nums would follows the same recursion template as 8.20. with + as Aug function. 
(defun add-nums (n)
  (cond ((zerop n) 0)
	(t (+ n (add-nums (- n 1))))))


;8.22
; This problem doesn't need augmentation 
; I will use Single Test Tail Recursion

(defun all-equal (x)
  (cond ((< (length x) 2) t)
	((eql (car x) (car (cdr x))) (all-equal (cdr x)))
	(t nil)))


;;8.23

;N  First      Second     Result
;5  'ha        (laugh 4)  (ha ha ha ha ha) 
;4  'ha        (laugh 3)  (ha ha ha ha) 
;3  'ha        (laugh 2)  (ha ha ha)
;2  'ha        (laugh 1)  (ha ha)
;1  'ha        (laugh 0)  (ha)
;0                        nil


;;8.24
(defun count-down (n)
  (cond ((zerop n) nil)
	(t (cons n (count-down (- n 1))))))

;;8.25 
(defun fact-ap (n)
  (let ((a 1))
    (dolist (x (count-down n))
      (setf a (* a x)))
    a))

;;8.26
(defun count-down (n)
  (cond ((zerop n) (list 0))
	(t (cons n (count-down (- n 1))))))

(defun count-down (n)
  (cond ((= 0 n) nil)
	(t (cons n (count-down (- n 1))))))


;;8.27
(defun square-list (x)
  (cond ((null x) nil)
	(t (cons (* (car x) (car x))
		 (square-list (cdr x))))))

;;8.28
(defun my-nth (i x)
  (cond ((or (zerop i) (null x)) (first x))
	(t (my-nth (- i 1) (cdr x)))))

;;8.29
(defun my-member (obj lst)
  (cond ((null lst) nil)
	((eql obj (car lst)) lst)
	(t (my-member obj (cdr lst)))))

;;8.30
(defun rec-assoc (key alist)
  (cond ((null alist) nil)
	((eql key (caar alist)) (car alist))
	(t (rec-assoc key (cdr alist)))))

;;8.31
(defun compare-length (x y)
  (cond ((and (null x) (null y)) 'SAME_LENGTH)
	((null x) 'SECOND_IS_LONGER)
	((null y) 'FIRST_IS_LONGER)
	(t (compare-length (cdr x) (cdr y)))))

;;8.32
(defun sum-numeric-elements (x)
  (cond ((null x) 0)
	((numberp (car x)) (+ (car x) (sum-numeric-elements (cdr x))))
	(t (sum-numeric-elements (cdr x)))))

;;8.33
(defun my-remove (o x)
  (cond ((null x) nil)
	((not (eql o (car x))) 
	  (cons (car x) (my-remove o (cdr x))))
	(t (my-remove o (cdr x)))))

;;8.35
(defun my-set-difference (x y)
  (cond ((null x) nil)
	((not (member (car x) y)) 
	  (cons (car x) (my-set-difference (cdr x) y )))
	(t (my-set-difference (cdr x) y))))

;;8.36
(defun count-odd (x)
  (cond ((null x) 0)
	((oddp (car x)) (+ 1 (count-odd (cdr x))))
	(t (count-odd (cdr x)))))

(defun count-odd1 (x)
  (cond ((null x) 0)
	(t (+ (if (oddp (car x)) 1 0)
	      (count-odd1 (cdr x)))))) 

;;8.37
(defun combine (a b)
  (+ a b))

(defun fib (n)
  (cond ((or (= n 0) (= n 1)) 1)
	(t (combine (fib (- n 1))
		    (fib (- n 2))))))

;Combiner is called on terminal calls. 

;;8.38
;Deleting the first condition would make the function run infinitely. 

;;8.39
(defun count-atoms (x)
  (cond ((null x) 0)
	((atom x) 1)
	(t (+ (count-atoms (car x))
	      (count-atoms (cdr x))))))

;;8.40
(defun count-cons (x)
  (cond ((null x) 0)
	((atom x) 0)
	(t (+ 1 
	      (count-cons (car x))
	      (count-cons (cdr x))))))

;;8.41
(defun sum-tree (x)
  (cond ((null x) 0)
	((numberp (car x)) (car x))
	(t (+ (sum-tree (car x))
	      (sum-tree (cdr x))))))

;;8.42
(defun my-subst (new old tree)
  (cond ((null tree) nil)
	((atom tree)(if (eql old tree) new tree))	
	(t (cons  (my-subst new old (car tree))
		  (my-subst new old (cdr tree))))))


;;8.43
(defun flatten (tr)
  (cond ((null tr) nil)
	((atom tr) (list tr))
	(t (append (flatten (car tr)) 
		   (flatten (cdr tr))))))
	       

;;8.44
(defun tree-depth (tr)
  (cond ((null tr) 0)
	((atom tr) 0)
	(t (+ 1 
	      (tree-depth (car tr))
	      (tree-depth (cdr tr)))))


;;8.45
(defun paren-depth (x)
  (cond ((null x) 0)
	((atom x) 0)
	(t (+  (if (consp (car x)) 1 0) 
	       (paren-depth (car x))
	       (paren-depth (cdr x))))))


;;8.46

(defun count-up (n)
  (cond ((zerop n) nil)
	(t (append (count-up (- n 1)) (list n)))))

;;8.47
(defun make-loaf (n)
  (if (zerop n)
      nil
      (cons 'x (make-loaf (- n 1)))))

;;8.48
;Single-test tail recursion.
(defun bury (w n)
  (cond ((zerop n) w)
	(t (bury (cons w nil) (- n 1)))))

;;8.49
(defun  pairings (a b)
  (cond ((null a) nil)
	(t (cons (list (car a) (car b))
		 (pairings (cdr a) (cdr b))))))

;8.50
(defun sublists (x)
  (cond ((null x) nil)
	(t (cons x (sublists (cdr x))))))

;;8.51
;Single-test Augmenting recursion
(defun my-reverse (x)
  (cond ((null (cdr x))  x)
	(t (append (my-reverse (cdr x)) (list (car x)))))) 

;Helper function recursion
(defun my-reverse2 (x)
  (my-reverse2-rec x nil))
 
;Single test tail recursion
(defun my-reverse2-rec (x r) 
  (cond ((null x) r)
	(t (my-reverse2-rec (cdr x) (cons (car x) r)))))


